home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / FGL402F.ZIP / EXFOR.ARJ / TEMP / FISHTANK.FOR < prev   
Text File  |  1995-01-20  |  10KB  |  305 lines
  1. C************************************************************************
  2. C
  3. C  FISHTANK.FOR -- This program demonstrates multi-object non-destructive
  4. C  animation.  The coral background is displayed on page 2 and copied to
  5. C  page 0, the visual page.  A packed pixel run file containing the 6 fish
  6. C  is displayed on page 1, and then FG_GETIMAGE is used to load the fish
  7. C  into the fish bitmaps.
  8. C
  9. C  To make the fish move, the background is copied to page 1 and the fish
  10. C  are put over the background using FG_CLPIMAGE and FG_FLPIMAGE.  The
  11. C  fish are clipped at the edge of the screen.  Page 1 is then copied to
  12. C  page 0 using FG_COPYPAGE.  This process is then repeated in a loop.
  13. C
  14. C  To compile this program and link it with Fastgraph version 3.xx:
  15. C
  16. C     FL /FPi /4I2 /4Nt /AM FISHTANK.FOR /link FGM
  17. C
  18. C  This program also can be linked with Fastgraph/Light (version 3.02 or
  19. C  later) if you replace the FGM library reference with FGLM.
  20. C
  21. C  For more examples of animation using Fastgraph, or for an evaluation
  22. C  copy of Fastgraph/Light, call DDBBS at (702) 796-7134.  For Fastgraph
  23. C  voice support, call Ted Gruber Software at (702) 735-1980.
  24. C
  25. C************************************************************************
  26.  
  27. $INCLUDE: 'C:\FG\FASTGRAF.FI'
  28.  
  29.       PROGRAM MAIN
  30.       IMPLICIT INTEGER (A-Z)
  31.  
  32.       COMMON /SEED/ SEED
  33.  
  34. C *** fish bitmaps ***
  35.  
  36.       INTEGER*1 FISHES
  37.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  38.  
  39. C *** palette values
  40.  
  41.       INTEGER COLORS(16)
  42.       DATA COLORS /0,1,2,3,4,5,6,7,16,0,18,19,20,21,22,23/
  43.  
  44. C *** make sure the system supports video mode 13 with 4 pages
  45.  
  46.       CALL FG_INITPM
  47.       IF (FG_TESTMODE(13,4) .EQ. 0) THEN
  48.          WRITE(6,*)
  49.          WRITE(6,*) 'This program requires an EGA or VGA card'
  50.          WRITE(6,*) 'with at least 128k.  If an EGA card is'
  51.          WRITE(6,*) 'present, it must be the active adapter.'
  52.          STOP ' '
  53.       END IF
  54.  
  55. C *** initialize the video environment
  56.  
  57.       OLD_MODE = FG_GETMODE()
  58.       CALL FG_SETMODE(13)
  59.       CALL FG_PALETTES(COLORS)
  60.       CALL RANDOMIZE
  61.  
  62. C *** get the coral background from a file and put it on page 2
  63.  
  64.       CALL FG_SETPAGE(2)
  65.       CALL FG_MOVE(0,199)
  66.       CALL FG_DISPFILE('CORAL.PPR'//CHAR(0),320,1)
  67.  
  68. C *** copy the background from page 2 to page 0, the visual page
  69.  
  70.       CALL FG_COPYPAGE(2,0)
  71.  
  72. C *** get the fish
  73.  
  74.       CALL GET_FISH
  75.  
  76. C *** make the fish go
  77.  
  78.       CALL GO_FISH
  79.  
  80. C *** restore the original video state
  81.  
  82.       CALL FG_SETMODE(OLD_MODE)
  83.       CALL FG_RESET
  84.  
  85.       STOP ' '
  86.       END
  87.  
  88. C************************************************************************
  89. C*                                                                      *
  90. C*            get_fish -- fill up the fish bitmap arrays                *
  91. C*                                                                      *
  92. C************************************************************************
  93.  
  94.       SUBROUTINE GET_FISH
  95.       IMPLICIT INTEGER (A-Z)
  96.  
  97.       INTEGER*1 FISHES
  98.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  99.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  100.  
  101. C *** get the fish from a file and put them on page 1
  102.  
  103.       CALL FG_SETPAGE(1)
  104.       CALL FG_MOVE(0,199)
  105.       CALL FG_DISPFILE('FISH.PPR'//CHAR(0),320,1)
  106.  
  107. C *** build the fish bitmaps
  108.  
  109.       I = 1
  110.       DO 10 FISH_NUM = 1,6
  111.          CALL FG_MOVE(FISH_X1(FISH_NUM),FISH_Y1(FISH_NUM))
  112.          CALL FG_GETIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  113.          OFFSET(FISH_NUM) = I
  114.          I = I + WIDTH(FISH_NUM) * HEIGHT(FISH_NUM)
  115. 10    CONTINUE
  116.  
  117.       RETURN
  118.       END
  119.  
  120. C************************************************************************
  121. C*                                                                      *
  122. C*             go_fish -- make the fish swim around                     *
  123. C*                                                                      *
  124. C************************************************************************
  125.  
  126.       SUBROUTINE GO_FISH
  127.       IMPLICIT INTEGER (A-Z)
  128.  
  129. C     There are 11 fish total, and 6 different kinds of fish.  These
  130. C     arrays keep track of what kind of fish each fish is, and how each
  131. C     fish moves:
  132. C
  133. C     fish()   -- which fish bitmap applies to this fish?
  134. C     x()      -- starting x coordinate
  135. C     y()      -- starting y coordinate
  136. C
  137. C     xmin()   -- how far left (off screen) the fish can go
  138. C     xmax()   -- how far right (off screen) the fish can go
  139. C     xinc()   -- how fast the fish goes left and right
  140. C     dir()    -- starting direction for each fish
  141. C
  142. C     ymin()   -- how far up this fish can go
  143. C     ymax()   -- how far down this fish can go
  144. C     yinc()   -- how fast the fish moves up or down
  145. C     yturn()  -- how long fish can go in the vertical direction
  146. C               before stopping or turning around
  147. C     ycount() -- counter to compare to yturn
  148.  
  149.       PARAMETER (NFISH = 11)
  150.  
  151.       INTEGER*1 KEY, AUX
  152.  
  153.       INTEGER*1 FISHES
  154.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  155.  
  156.       INTEGER FISH(NFISH), X(NFISH), Y(NFISH)
  157.       INTEGER XMIN(NFISH), XMAX(NFISH), XINC(NFISH)
  158.       INTEGER YMIN(NFISH), YMAX(NFISH), YINC(NFISH)
  159.       INTEGER DIR(NFISH), YTURN(NFISH), YCOUNT(NFISH)
  160.  
  161.       DATA FISH /   2,   2,   3,   4,   4,   1,   1,   6,   5,   3,   4/
  162.       DATA X    /-100,-150,-450,-140,-200, 520, 620,-800, 800, 800,-300/
  163.       DATA Y    /  40,  60, 150,  80,  70, 190, 180, 100,  30, 130,  92/
  164.  
  165.       DATA XMIN /-300,-300,-800,-200,-200,-200,-300,-900,-900,-900,-400/
  166.       DATA XMAX / 600, 600,1100,1000,1000, 750, 800,1200,1400,1200, 900/
  167.       DATA XINC /   2,   2,   8,   5,   5,  -3,  -3,   7,  -8,  -9,   6/
  168.       DATA DIR  /   0,   0,   0,   0,   0,   1,   1,   0,   1,   1,   0/
  169.  
  170.       DATA YMIN /  40,  60, 120,  70,  60, 160, 160,  80,  30, 110,  72/
  171.       DATA YMAX /  80, 100, 170, 110, 100, 199, 199, 120,  70, 150, 122/
  172.       DATA YTURN/  50,  30,  10,  30,  20,  10,  10,  10,  30,   20, 10/
  173.       DATA YCOUNT/  0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0/
  174.       DATA YINC /   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0/
  175.  
  176. C *** make the fish swim around
  177.  
  178. 10    CONTINUE
  179.  
  180. C *** copy the background from page 2 to page 1
  181.  
  182.       CALL FG_COPYPAGE(2,1)
  183.  
  184. C *** put all the fish on the background
  185.  
  186.       DO 20 I = 1,11
  187.  
  188.          CALL FG_SETPAGE(1)
  189.          YCOUNT(I) = YCOUNT(I) + 1
  190.          IF (YCOUNT(I) .GT. YTURN(I)) THEN
  191.             YCOUNT(I) = 0
  192.             YINC(I) = IRANDOM(-1,1)
  193.          END IF
  194.          Y(I) = Y(I) + YINC(I)
  195.          Y(I) = MIN(YMAX(I),MAX(Y(I),YMIN(I)))
  196.  
  197.          IF (X(I) .GE. 0 .AND. X(I) .LT. 320) THEN
  198.             CALL PUT_FISH(FISH(I),X(I),Y(I),DIR(I))
  199.          ELSE IF (X(I) .LT. 0 .AND. X(I) .GT. -72) THEN
  200.             CALL FG_TRANSFER(0,71,0,199,104,199,1,3)
  201.             CALL FG_SETPAGE(3)
  202.             CALL PUT_FISH(FISH(I),X(I)+104,Y(I),DIR(I))
  203.             CALL FG_TRANSFER(104,175,0,199,0,199,3,1)
  204.          END IF
  205.          X(I) = X(I) + XINC(I)
  206.          IF (X(I) .LE. XMIN(I) .OR. X(I) .GE. XMAX(I)) THEN
  207.             XINC(I) = -XINC(I)
  208.             DIR(I) = 1 - DIR(I)
  209.          END IF
  210.  
  211. 20    CONTINUE
  212.  
  213. C *** copy page 1 to page 0
  214.  
  215.       CALL FG_SETPAGE(0)
  216.       CALL FG_COPYPAGE(1,0)
  217.  
  218. C *** intercept a keystroke, if it is escape exit the program
  219.  
  220.       CALL FG_INTKEY(KEY,AUX)
  221.       IF (KEY .NE. 27) GO TO 10
  222.  
  223.       RETURN
  224.       END
  225.  
  226. C************************************************************************
  227. C*                                                                      *
  228. C*                irandom -- random number generator                    *
  229. C*                                                                      *
  230. C************************************************************************
  231.  
  232.       FUNCTION IRANDOM(MIN,MAX)
  233.       IMPLICIT INTEGER (A-Z)
  234.  
  235.       TEMP = IEOR(SEED,ISHFT(SEED,-7))
  236.       SEED = IAND(IEOR(ISHFT(TEMP,8),TEMP),#7FFF)
  237.       IRANDOM = MOD(SEED,MAX-MIN+1) + MIN
  238.  
  239.       RETURN
  240.       END
  241.  
  242. C************************************************************************
  243. C*                                                                      *
  244. C*      put_fish -- draw one of the six fish anywhere you want          *
  245. C*                                                                      *
  246. C************************************************************************
  247.  
  248.       SUBROUTINE PUT_FISH(FISH_NUM,X,Y,FISH_DIR)
  249.       IMPLICIT INTEGER (A-Z)
  250.  
  251.       INTEGER*1 FISHES
  252.       COMMON /MAPS/ FISHES(5356), OFFSET(6)
  253.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  254.  
  255. C *** move to position where the fish will appear
  256.  
  257.       CALL FG_MOVE(X,Y)
  258.  
  259. C *** draw a left- or right-facing fish, depending on fish_dir
  260.  
  261.       I = OFFSET(FISH_NUM)
  262.       IF (FISH_DIR .EQ. 0) THEN
  263.          CALL FG_FLPIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  264.       ELSE
  265.          CALL FG_CLPIMAGE(FISHES(I),WIDTH(FISH_NUM),HEIGHT(FISH_NUM))
  266.       END IF
  267.  
  268.       RETURN
  269.       END
  270.  
  271. C************************************************************************
  272. C*                                                                      *
  273. C*       randomize -- get a seed for the random number generator        *
  274. C*                                                                      *
  275. C************************************************************************
  276.  
  277.       SUBROUTINE RANDOMIZE
  278.       IMPLICIT INTEGER (A-Z)
  279.  
  280.       COMMON /SEED/ SEED
  281.  
  282.       INTEGER*4 FG_GETCLOCK
  283.  
  284.       SEED = IAND(INT(FG_GETCLOCK()),#7FFF)
  285.  
  286.       RETURN
  287.       END
  288.  
  289. C************************************************************************
  290. C*                                                                      *
  291. C*      block data -- initialize arrays in common blocks                *
  292. C*                                                                      *
  293. C************************************************************************
  294.  
  295.       BLOCK DATA
  296.       IMPLICIT INTEGER (A-Z)
  297.  
  298.       COMMON /SIZE/ FISH_X1(6), FISH_Y1(6), WIDTH(6), HEIGHT(6)
  299.       DATA FISH_X1 /  0, 64,128,200,  0, 80/
  300.       DATA FISH_Y1 /199,199,199,199,150,150/
  301.       DATA WIDTH   / 28, 27, 34, 28, 31, 34/
  302.       DATA HEIGHT  / 25, 38, 26, 30, 22, 36/
  303.  
  304.       END
  305.